home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / PROLOG / BP330 / !BinPro330 / progs / semi3 < prev    next >
Text File  |  1994-02-25  |  6KB  |  200 lines
  1. go:-go('BMARK_semigroup:').
  2.  
  3. go(Mes):-go(T,N),write(Mes=[time(T),n(N)]),nl.
  4.  
  5.  
  6. /*-----------------------------------------------------------------------------
  7. Program:  Semigroup (hash 2--3 tree version)
  8. Author:   R. Overbeek
  9. Modified: E. Tick
  10. Date:     January 12 1989
  11.  
  12. Notes:
  13. 1. To run:
  14.     ?- go(T,N).
  15. where T is time and N should be output 313.
  16.  
  17. 2. This version includes the generators in the answer (KL1 version doesn't)
  18.  
  19. 3. This version has tuple length hardwired: BE CAREFUL!
  20.  
  21. 4. Here we use a psuedo-hash 2--3 tree: each tuple has a hash key as its first
  22. element, thus we do not need to implement buckets: the 2--3 tree code takes
  23. care of synonyms by continuing to check the rest of the tuple!  Note that
  24. the hash function is very good: only five synonyms generated out of 313 keys.
  25. -----------------------------------------------------------------------------
  26. :- sequential.
  27. :- parallel member/2, umember/2.
  28. */
  29.  
  30. go(T,N) :-
  31.     init_sos(Kernel,Sub),
  32.     time(_),
  33.     loop(Kernel, Sub, Kernel, Hbg, Kernel),
  34.     time(T),
  35.     count(Hbg, N).
  36.  
  37. init_sos(Sos,Sub) :-
  38.     sos(Sos),
  39.     extend_tree(Sos,nil,Sub).
  40.  
  41. % Sos = list of tuples that need to be processed
  42. % Sub = tree corresponding to the (partial) semigroup Hbg
  43. % Hbg = partial semigroup tuples (initially [])
  44. % 
  45. loop([], _, Hbg, Hbg, _) :- !.
  46. loop(Sos, Sub, Hbg, F, Kernel) :-
  47.     findall(Tuple, newtup(Sos, Kernel, Sub, Tuple), L),
  48.     filter(L, Sub, NewSub, [], NewSos, Hbg, NewHbg),
  49.     loop(NewSos, NewSub, NewHbg, F, Kernel).
  50.  
  51. % all the parallelism comes from here...
  52. % the order of the umember goals does not seem to matter much
  53. % the first umember can be changed to member with no slow-down
  54. newtup(L,K,Sub,New) :-
  55.     umember(E1,L),     % new candidates
  56.     umember(E2,K),     % kernel (four elements here)
  57.     bigm(E2,E1,New),
  58.     \+ acc23(Sub,New).
  59.  
  60. filter(   [], Sub,  Sub, Sos,  Sos, Hbg,  Hbg).
  61. filter([H|T], Sub, SubF, Sos, SosF, Hbg, HbgF) :-
  62.     (add23(Sub,H,Sub1) ->
  63.         Sos1=[H|Sos], 
  64.         Hbg1=[H|Hbg]
  65.     ;
  66.         Sub1=Sub, 
  67.         Sos1=Sos,
  68.         Hbg1=Hbg
  69.     ),
  70.     filter(T, Sub1, SubF, Sos1, SosF, Hbg1, HbgF).
  71.  
  72. bigm(W1,W2,P) :- 
  73.     functor(P,tuple,41),           % one extra element for hash key...
  74.     mtab(Table),
  75.     bigm(2,W1,W2,P,Table,0).
  76.  
  77. bigm(42,_,_,P,_,Key) :- !,         % insert hash key as first element!
  78.     arg(1,P,Key).
  79. bigm(I,W0,W1,P,Table,Key) :- I<42,
  80.     arg(I,W0,X),
  81.     arg(I,W1,Y),
  82.     arg(X,Table,Row), 
  83.     arg(Y,Row,Z),
  84.     arg(I,P,Z),
  85.     J is I+1,
  86.     NewKey is Z+Key*3,             % hash function overflows, but gets only
  87.     bigm(J,W0,W1,P,Table,NewKey).  % five synonyms in 313 tuples!
  88.  
  89. % utilities...
  90. lmember(H,[H|_]). 
  91. lmember(H,[_|T]) :- lmember(H,T).
  92.  
  93. % unrolling pass this point doesn't improve things...
  94.  
  95. umember(H,[H|_]).
  96. umember(H,[_,H|T]).
  97. umember(H,[_,_,H|T]).
  98. umember(H,[_,_,_,H|T]).
  99. umember(H,[_,_,_,_|T]) :- umember(H,T).
  100.  
  101. extend_tree([],S,S).
  102. extend_tree([E|T],S,S1) :-
  103.     add23(S,E,S2),
  104.     extend_tree(T,S2,S1).
  105.  
  106. count(L,N) :- count(L,0,N).
  107. count([X|Xs],M,N) :- M1 is M+1, count(Xs,M1,N).
  108. count([],N,N).
  109.  
  110. time(T) :- statistics(runtime,[_,T]).
  111.  
  112. % 2-3 Trees: code from I. Bratko, "Prolog Programming for AI"
  113. acc23(l(X),           X) :-          !.
  114. acc23(n2(T1,M,_),     X) :-  M @> X, !, acc23(T1,X).
  115. acc23(n2(_,_,T2),     X) :-          !, acc23(T2,X).
  116. acc23(n3(T1,M2,_,_,_),X) :- M2 @> X, !, acc23(T1,X).
  117. acc23(n3(_,_,T2,M3,_),X) :- M3 @> X, !, acc23(T2,X).
  118. acc23(n3(_,_,_,_,T3), X) :-             acc23(T3,X).
  119.  
  120. add23(Tree,X,Tree1) :- 
  121.     ins(Tree,X,Tree1).
  122. add23(Tree,X,n2(T1,M2,T2)) :- 
  123.     ins(Tree,X,T1,M2,T2).
  124.  
  125. ins(nil,X,l(X)) :- !.
  126. ins(n2(T1,M,T2),X,n2(NT1,M,T2)) :- M @> X,
  127.     ins(T1,X,NT1).
  128. ins(n2(T1,M,T2),X,n3(NT1a,Mb,NT1b,M,T2)) :- M @> X, !,
  129.     ins(T1,X,NT1a,Mb,NT1b).
  130. ins(n2(T1,M,T2),X,n2(T1,M,NT2)) :- X @> M, 
  131.     ins(T2,X,NT2).
  132. ins(n2(T1,M,T2),X,n3(T1,M,NT2a,Mb,NT2b)) :- X @> M, !,
  133.     ins(T2,X,NT2a,Mb,NT2b).
  134. ins(n3(T1,M2,T2,M3,T3),X,n3(NT1,M2,T2,M3,T3)) :- M2 @> X, !,
  135.     ins(T1,X,NT1).
  136. ins(n3(T1,M2,T2,M3,T3),X,n3(T1,M2,NT2,M3,T3)) :- X @> M2, M3 @> X, !,
  137.     ins(T2,X,NT2).
  138. ins(n3(T1,M2,T2,M3,T3),X,n3(T1,M2,T2,M3,NT3)) :- X @> M3,
  139.     ins(T3,X,NT3).
  140.  
  141. ins(l(A),X,l(A),X,l(X)) :- X @> A, !.
  142. ins(l(A),X,l(X),A,l(A)) :- A @> X, !.
  143. ins(n3(T1,M2,T2,M3,T3),X,n2(NT1a,Mb,NT1b),M2,n2(T2,M3,T3)) :- M2 @> X, !,
  144.     ins(T1,X,NT1a,Mb,NT1b).
  145. ins(n3(T1,M2,T2,M3,T3),X,n2(T1,M2,NT2a),Mb,n2(NT2b,M3,T3)) :- 
  146.     X @> M2, M3 @> X, !,
  147.     ins(T2,X,NT2a,Mb,NT2b).
  148. ins(n3(T1,M2,T2,M3,T3),X,n2(T1,M2,T2),M3,n2(NT3a,Mb,NT3b)) :- X @> M3,
  149.     ins(T3,X,NT3a,Mb,NT3b).
  150.  
  151. /*
  152. % show tree...
  153. show(T) :- show(T,0).
  154.  
  155. show(nil, _).
  156. show(l(A),H) :- tab(H), write(A), nl.
  157. show(n2(T1,M,T2),H) :-
  158.     H1 is H+5,
  159.     show(T2,H1),
  160.     tab(H), write('--'), nl,
  161.     tab(H), write(M), nl,
  162.     tab(H), write('--'), nl,
  163.     show(T1,H1).
  164. show(n3(T1,M2,T2,M3,T3),H) :-
  165.     H1 is H+5,
  166.     show(T3,H1),
  167.     tab(H), write('--'), nl,
  168.     tab(H), write(M3), nl,
  169.     show(T2,H1),
  170.     tab(H), write(M2), nl,
  171.     tab(H), write('--'), nl,
  172.     show(T1,H1).
  173. */
  174.  
  175. /* 
  176. % original problem (Melbourne paper by Overbeek & Lusk)
  177. sos([tuple(1,1,1,1,1,2,2,2,2,2,3,3,3,3,3,4,4,4,4,4,5,5,5,5,5),
  178.      tuple(1,2,3,4,5,1,2,3,4,5,1,2,3,4,5,1,2,3,4,5,1,2,3,4,5),
  179.      tuple(1,1,1,1,1,2,2,2,2,2,3,3,3,3,3,5,5,5,5,5,4,4,4,4,4),
  180.      tuple(1,2,3,5,4,1,2,3,5,4,1,2,3,5,4,1,2,3,5,4,1,2,3,5,4)]).
  181. */
  182.  
  183. % 309+4 solutions: 
  184. % to boost execution time by 20% switch elements 28 & 29 in last row!
  185. sos([tuple(1000, 1,1,1,1,1,2,2,2,2,2,3,3,3,3,3,4,4,4,4,4, 
  186.            5,5,5,5,5,3,3,3,3,3,5,5,5,5,5,4,4,4,4,4),
  187.      tuple(2000, 1,2,3,4,5,1,2,3,4,5,1,2,3,4,5,1,2,3,4,5, 
  188.            1,2,3,4,5,1,2,3,4,5,1,3,2,4,5,1,2,3,4,5),
  189.      tuple(3000, 1,1,1,1,1,2,2,2,2,2,3,3,3,3,3,5,5,5,5,5,
  190.            4,4,4,4,4,2,2,2,2,2,4,4,4,4,4,3,3,3,3,3),
  191.      tuple(4000, 1,2,3,5,4,1,2,3,5,4,1,2,3,5,4,1,2,3,5,4, 
  192.            1,2,3,5,4,1,2,3,4,5,1,2,3,5,4,1,2,3,5,4)]).
  193.  
  194. mtab(table(row(1,1,1,1,1),
  195.            row(1,2,1,4,1),
  196.            row(1,1,3,1,5),
  197.            row(1,1,4,1,2),
  198.            row(1,5,1,3,1))).
  199.  
  200.